home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Extensions / socket.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-22  |  13.1 KB  |  475 lines
  1. /*
  2.  * This file is based on a contribution of David Tolpin (dvd@pizza.msk.su)
  3.  * It is an implementation of BSD-INET sockets and is known to run on 
  4.  * Solaris 1 and Linux.
  5.  *
  6.  * Bugs correction (conversion between host and network byte order) by
  7.  * Marc Furrer (Marc.Furrer@di.epfl.ch)
  8.  *
  9.  * Reworked  by Erick Gallesio for 2.2 release. Some additions and simplifications
  10.  * (I hope). 
  11.  * 
  12.  * Last file update: 22-Jul-1996 21:04
  13.  */
  14.  
  15. #include "stk.h"
  16. #include <errno.h>
  17. #include <sys/types.h>
  18. #include <sys/socket.h>
  19. #include <netinet/in.h>
  20. #include <arpa/inet.h>
  21. #include <netdb.h>
  22. #include <memory.h>
  23.  
  24. struct socket_type {
  25.   int portnum;
  26.   SCM hostname, hostip;
  27.   int fd;
  28.   SCM input, output;
  29.   SCM ready_event;
  30. };
  31.  
  32. static int tc_socket;
  33.  
  34. #define SOCKET(x)   ((struct socket_type*)(x->storage_as.extension.data))
  35. #define LSOCKET(x)  (x->storage_as.extension.data)
  36. #define SOCKETP(x)  (TYPEP(x,tc_socket))
  37. #define NSOCKETP(x) (NTYPEP(x,tc_socket))
  38.  
  39. /******************************************************************************
  40.  *
  41.  *   U t i l i t i e s
  42.  *
  43.  ******************************************************************************/
  44.  
  45. static void system_error(char *who)
  46. {
  47.   char buffer[512]; /* should suffice */
  48.   
  49.   sprintf(buffer, "%s: %s", who, strerror(errno));
  50.   Err(buffer, NIL);
  51. }
  52.  
  53. static void socket_error(char *who, char *message, SCM object)
  54. {
  55.   char buffer[512]; /* should suffice */
  56.   
  57.   sprintf(buffer, "%s: %s", who, message);
  58.   Err(buffer, object);
  59. }
  60.  
  61. static void set_socket_io_ports(int s, SCM sock, char *who)
  62. {
  63.   int t, len, port;
  64.   char *hostname, *fname;
  65.   FILE *fs, *ft;
  66.     
  67.   STk_disallow_sigint();
  68.   t = dup(s); /* duplicate handles so that we are able to access one 
  69.          socket channel via two scheme ports */
  70.  
  71.   if(!((fs = fdopen(s, "r")) && (ft = fdopen(t, "w")))) {
  72.     char buffer[200];
  73.     
  74.     sprintf(buffer, "%s: cannot create socket io ports", who);
  75.     Err(buffer, NIL);
  76.   }
  77.   port     = SOCKET(sock)->portnum;
  78.   hostname = CHARS(SOCKET(sock)->hostname);
  79.   len      = strlen(hostname) + 20;
  80.   fname    =  (char*) must_malloc(len);
  81.   sprintf(fname, "%s:%d", hostname, port);
  82.  
  83.   /* Create input port */
  84.   SOCKET(sock)->input = STk_Cfile2port(fname, fs, tc_iport, 0);
  85.  
  86.   /* Create output port */
  87.   SOCKET(sock)->output = STk_Cfile2port(strdup(fname), ft, tc_oport, 0);
  88.  
  89.   STk_allow_sigint();
  90. }
  91.  
  92. /******************************************************************************
  93.  *
  94.  *   m a k e - c l i e n t - s o c k e t
  95.  *
  96.  ******************************************************************************/
  97.  
  98. static PRIMITIVE make_client_socket(SCM hostname, SCM port)
  99. {
  100.   char str[] = "make-client-socket";
  101.   struct hostent *hp;
  102.   struct sockaddr_in server;
  103.   struct in_addr local_ip;
  104.   SCM z, local_host;
  105.   int s;
  106.  
  107.   /* Verify arguments */
  108.   if(NSTRINGP(hostname)) 
  109.     socket_error(str, "bad hostname", hostname);
  110.   if(NINTEGERP(port))
  111.     socket_error(str, "bad port number", port);
  112.  
  113.   /* Locate the host IP address */
  114.   if ((hp=gethostbyname(CHARS(hostname))) == NULL)
  115.     socket_error(str, "unknown or misspelled host name", hostname);
  116.  
  117.   /* Get a socket */
  118.   if ((s=socket(AF_INET,SOCK_STREAM,0)) < 0)  
  119.     socket_error(str, "cannot create socket", NIL);
  120.  
  121.   /* Setup a connect address */
  122.   memset(&server, 0, sizeof(server));
  123.   memcpy((char*)&server.sin_addr, hp->h_addr, hp->h_length);
  124.   server.sin_family = AF_INET;
  125.   server.sin_port   = htons(INTEGER(port));
  126.  
  127.   /* Try to connect */
  128.   if (connect(s, (struct sockaddr *) &server, sizeof(server)) < 0) {
  129.     close(s);
  130.     system_error(str);
  131.   }
  132.  
  133.   /* Create a new Scheme socket object */
  134.   NEWCELL(z, tc_socket);
  135.   LSOCKET(z) = (struct socket_type*) 
  136.                     must_malloc(sizeof (struct socket_type));
  137.  
  138.   SOCKET(z)->portnum     = ntohs(server.sin_port); /* Query true value */
  139.   SOCKET(z)->hostname    = STk_makestring((char *) hp->h_name);
  140.   SOCKET(z)->hostip      = STk_makestring((char *) inet_ntoa(server.sin_addr));
  141.   SOCKET(z)->fd      = s;
  142.   SOCKET(z)->input      = Ntruth;
  143.   SOCKET(z)->output      = Ntruth;
  144.   SOCKET(z)->ready_event = Ntruth;
  145.  
  146.   set_socket_io_ports(s, z, str);
  147.   return z;
  148. }
  149.  
  150. /******************************************************************************
  151.  *
  152.  *   m a k e - s e r v e r - s o c k e t
  153.  *
  154.  ******************************************************************************/
  155.  
  156. static PRIMITIVE make_server_socket(SCM port)
  157. {
  158.   char msg[] = "make-server-socket";
  159.   struct sockaddr_in sin;
  160.   int s, portnum, len;
  161.   SCM local_host;
  162.   struct in_addr local_ip; 
  163.   SCM z;
  164.  
  165.   /* Determine port to use */
  166.   portnum = (port == UNBOUND) ? 0 : STk_integer_value(port);
  167.   if (portnum < 0)  Err("make-server-socket: bad port number", port);
  168.  
  169.   /* Create a socket */
  170.   if ((s = socket(AF_INET, SOCK_STREAM, 0)) < 0) Err("Cannot create socket", NIL);
  171.  
  172.   /* Bind the socket to a name */
  173.   sin.sin_family      = AF_INET;
  174.   sin.sin_port           = htons(portnum);
  175.   sin.sin_addr.s_addr = INADDR_ANY;
  176.  
  177.   if (bind(s, (struct sockaddr *) &sin, sizeof(sin)) < 0) {
  178.     close(s);
  179.     system_error(msg);
  180.   }
  181.  
  182.   /* Query the socket name (permits to get the true socket number if 0 was given */
  183.   len = sizeof(sin);
  184.   if (getsockname(s, (struct sockaddr *) &sin, (int *) &len) < 0) {
  185.     close(s);
  186.     system_error(msg);
  187.   }
  188.  
  189.   /* Indicate that we are ready to listen */
  190.   if (listen(s, 5) < 0) {
  191.     close(s);
  192.     system_error(msg);
  193.   }
  194.  
  195.   /* Now we can create the socket object */
  196.   NEWCELL(z, tc_socket);
  197.   LSOCKET(z) = (struct socket_type*) 
  198.                     must_malloc(sizeof (struct socket_type));
  199.   SOCKET(z)->portnum      = ntohs(sin.sin_port);
  200.   SOCKET(z)->hostname     = Ntruth;
  201.   SOCKET(z)->hostip      = Ntruth;
  202.   SOCKET(z)->fd           = s;
  203.   SOCKET(z)->input      = Ntruth;
  204.   SOCKET(z)->output      = Ntruth;
  205.   SOCKET(z)->ready_event  = Ntruth;
  206.  
  207.   return z;
  208. }
  209.  
  210. /******************************************************************************
  211.  *
  212.  *   s o c k e t - a c c e p t - c o n n e c t i o n
  213.  *
  214.  ******************************************************************************/
  215.  
  216. static PRIMITIVE socket_accept_connection(SCM sock)
  217. {
  218.   char buff[50], *s;
  219.   char str[]= "socket-accept-connection";
  220.   struct sockaddr_in sin;
  221.   struct hostent *host;
  222.   int len = sizeof(sin);
  223.   int new_s;
  224.  
  225.   if (NSOCKETP(sock)) 
  226.     socket_error(str, "bad socket", sock);
  227.   
  228.   if ((new_s = accept(SOCKET(sock)->fd, (struct sockaddr *) &sin, &len)) < 0)
  229.     system_error(str);
  230.  
  231.   /* Set the client info (if possible its name, otherwise its IP number) */
  232.   host = gethostbyaddr((char *) &sin.sin_addr, sizeof(sin.sin_addr), AF_INET);
  233.   s    = (char *) inet_ntoa(sin.sin_addr);
  234.   
  235.   SOCKET(sock)->hostip   = STk_makestring(s);
  236.   SOCKET(sock)->hostname = STk_makestring(host? (char*) (host->h_name): s);
  237.  
  238.   set_socket_io_ports(new_s, sock, str);
  239.   return UNDEFINED;
  240. }
  241.  
  242. /******************************************************************************
  243.  *
  244.  *   w h e n - s o c k e t - r e a d y 
  245.  *
  246.  ******************************************************************************/
  247. static void apply_socket_closure(SCM closure)
  248. {
  249.   Apply(closure, NIL);
  250. }
  251.  
  252. static PRIMITIVE when_socket_ready(SCM s, SCM closure)
  253. {
  254.   char str[50];
  255.   Tcl_File f;
  256.  
  257.   if (NSOCKETP(s))
  258.     Err("when-socket-ready: bad socket", s);
  259.   
  260.   if (closure == UNBOUND) {
  261.     /* Return the current handler closure */
  262.     return SOCKET(s)->ready_event;
  263.   }
  264.   
  265.   f = Tcl_GetFile((ClientData) SOCKET(s)->fd,  TCL_UNIX_FD);
  266.   
  267.   if (closure == Ntruth) {
  268.     Tcl_DeleteFileHandler(f);    
  269.     SOCKET(s)->ready_event = Ntruth;
  270.   }
  271.   else {
  272.     if (STk_procedurep(closure) == Ntruth) 
  273.       Err("when-socket-ready: bad closure", closure);
  274.  
  275.     Tcl_CreateFileHandler(f, TCL_READABLE, (Tcl_FileProc *) apply_socket_closure, 
  276.               (ClientData) closure);
  277.     SOCKET(s)->ready_event = closure;
  278.   }
  279.   return UNDEFINED;
  280. }
  281.  
  282. static PRIMITIVE buggy_handler(SCM s, SCM closure)
  283. {
  284.   Err("when-socket-ready: cannot be used with snow", NIL);
  285. }
  286.  
  287. /******************************************************************************
  288.  *
  289.  *   s o c k e t - s h u t d o w n
  290.  *
  291.  ******************************************************************************/
  292.  
  293. static void shutdown_port(SCM port)
  294. {
  295.   int fd;
  296.   FILE *f;
  297.  
  298.   fd  = fileno(PORT_FILE(port));
  299.   if (!(PORT_FLAGS(port) & PORT_CLOSED)) /* not already closed */ shutdown(fd, 2);
  300. }
  301.  
  302. static PRIMITIVE socket_shutdown(SCM sock, SCM close_socket)
  303. {
  304.   if (close_socket == UNBOUND) close_socket = Truth;
  305.  
  306.   if (NSOCKETP(sock))            Err("socket-shutdown: bad socket", sock);
  307.   if (NBOOLEANP(close_socket)) Err("socket-shutdown: bad boolean", close_socket);
  308.  
  309.   if (close_socket == Truth && SOCKET(sock)->fd > 0) {
  310.     if (!STk_snow_is_running)
  311.       /* We cannot use #ifdef USE_TK here to have the same socket.so
  312.        * for both snow and stk. So we have to test if we are running 
  313.        * snow dynamically
  314.        */
  315.       Tcl_DeleteFileHandler(Tcl_GetFile((ClientData) SOCKET(sock)->fd, 
  316.                     TCL_UNIX_FD));
  317.     close(SOCKET(sock)->fd);
  318.     SOCKET(sock)->fd = -1;
  319.   }
  320.  
  321.   shutdown_port(SOCKET(sock)->input);  
  322.   shutdown_port(SOCKET(sock)->output); 
  323.   
  324.   /* Unset input and ouput pointers. By doing that, GC will close the
  325.    * input and ouput files later.
  326.    */
  327.   SOCKET(sock)->input = SOCKET(sock)->output = Ntruth;
  328.   return UNDEFINED;
  329. }
  330.  
  331. /******************************************************************************
  332.  *
  333.  *   O t h e r   s o c k e t   p r i m i t i v e s
  334.  *
  335.  ******************************************************************************/
  336.  
  337. static PRIMITIVE socketp(SCM sock)
  338. {
  339.   return SOCKETP(sock)? Truth: Ntruth;
  340. }
  341.  
  342. static PRIMITIVE socket_port_number(SCM sock)
  343. {
  344.   if (NSOCKETP(sock)) Err("socket-port-number: bad socket", sock);
  345.   return STk_makeinteger(SOCKET(sock)->portnum);
  346. }
  347.  
  348. static PRIMITIVE socket_input(SCM sock)
  349. {
  350.   if (NSOCKETP(sock)) Err("socket-input: bad socket", sock);
  351.   return SOCKET(sock)->input;
  352. }
  353.  
  354. static PRIMITIVE socket_output(SCM sock)
  355. {
  356.   if (NSOCKETP(sock)) Err("socket-output: bad socket", sock);
  357.   return SOCKET(sock)->output;
  358. }
  359.  
  360. static PRIMITIVE socket_hostname(SCM sock)
  361. {
  362.   if (NSOCKETP(sock)) Err("socket-hostname: bad socket", sock);
  363.   return SOCKET(sock)->hostname;
  364. }
  365.  
  366. static PRIMITIVE socket_host_address(SCM sock)
  367. {
  368.   if (NSOCKETP(sock)) Err("socket-host-address: bad socket", sock);
  369.   return SOCKET(sock)->hostip;
  370. }
  371.  
  372. static PRIMITIVE socket_downp(SCM sock)
  373. {
  374.   if (NSOCKETP(sock)) Err("socket-down?: bad socket", sock);
  375.   return (SOCKET(sock)->fd == -1) ? Truth: Ntruth;
  376. }
  377.  
  378. static PRIMITIVE socket_dup(SCM socket)
  379. {
  380.   SCM z;
  381.   int new_fd;
  382.  
  383.   if (NSOCKETP(socket)) Err("socket-dup: bad socket", socket);
  384.   
  385.   if ((new_fd=dup(SOCKET(socket)->fd)) < 0)
  386.     Err("socket-dup: cannot duplicate socket", socket);
  387.  
  388.   NEWCELL(z, tc_socket);
  389.   LSOCKET(z) = (struct socket_type*) must_malloc(sizeof (struct socket_type));
  390.  
  391.   *SOCKET(z) = *SOCKET(socket);
  392.   SOCKET(z)->fd = new_fd;  
  393.  
  394.   return z;
  395. }
  396.  
  397.  
  398. static PRIMITIVE socket_local_addr(SCM sock)
  399. {
  400.   struct sockaddr_in sin;
  401.   int len = sizeof(sin);
  402.  
  403.   if (NSOCKETP(sock)) Err("socket-local-address: bad socket", sock);
  404.  
  405.   if (getsockname(SOCKET(sock)->fd, (struct sockaddr *) &sin, &len))
  406.     Err("socket-local-address: cannot get socket name", sock);
  407.  
  408.   return STk_makestring((char *) inet_ntoa(sin.sin_addr));
  409. }
  410.   
  411.  
  412. /******************************************************************************/
  413.  
  414.  
  415. static void mark_socket(SCM sock)
  416. {
  417.   STk_gc_mark(SOCKET(sock)->hostname);
  418.   STk_gc_mark(SOCKET(sock)->hostip);
  419.   STk_gc_mark(SOCKET(sock)->input);
  420.   STk_gc_mark(SOCKET(sock)->output);
  421.   STk_gc_mark(SOCKET(sock)->ready_event);
  422. }
  423.  
  424. static void free_socket(SCM sock)
  425. {
  426.   socket_shutdown(sock, Truth);
  427.   free(SOCKET(sock));
  428. }
  429.  
  430. static void displ_socket(SCM sock, SCM port, int mode)
  431. {
  432.   struct socket_type *s = SOCKET(sock);
  433.  
  434.   sprintf(STk_tkbuffer, "#[socket %s %d]", 
  435.               (s->hostname == Ntruth)?"*none*": CHARS(s->hostname),
  436.               s->portnum);
  437.   Puts(STk_tkbuffer, PORT_FILE(port));
  438. }
  439.  
  440. static STk_extended_scheme_type socket_type = {
  441.   "socket",        /* name */
  442.   0,             /* is_procp */
  443.   mark_socket,         /* gc_mark_fct */
  444.   free_socket,        /* gc_free_fct */
  445.   NULL,            /* apply_fct */
  446.   displ_socket        /* display_fct */
  447. };
  448.  
  449. /******************************************************************************/
  450.  
  451. PRIMITIVE STk_init_socket(void)
  452. {
  453.   tc_socket = STk_add_new_type(&socket_type);
  454.  
  455.   STk_add_new_primitive("make-client-socket",  tc_subr_2,      make_client_socket);
  456.   STk_add_new_primitive("make-server-socket",  tc_subr_0_or_1, make_server_socket);
  457.   STk_add_new_primitive("socket-accept-connection",
  458.                                    tc_subr_1, socket_accept_connection);
  459.   STk_add_new_primitive("socket?",           tc_subr_1,      socketp);
  460.   STk_add_new_primitive("socket-port-number",  tc_subr_1,      socket_port_number);
  461.   STk_add_new_primitive("socket-input",        tc_subr_1,      socket_input);
  462.   STk_add_new_primitive("socket-output",       tc_subr_1,      socket_output);
  463.   STk_add_new_primitive("socket-host-name",    tc_subr_1,      socket_hostname);
  464.   STk_add_new_primitive("socket-host-address", tc_subr_1,      socket_host_address);
  465.   STk_add_new_primitive("socket-shutdown",     tc_subr_1_or_2, socket_shutdown);
  466.   STk_add_new_primitive("socket-down?",        tc_subr_1,      socket_downp);
  467.   STk_add_new_primitive("socket-local-address",tc_subr_1,      socket_local_addr);
  468.   STk_add_new_primitive("socket-dup",            tc_subr_1,      socket_dup);
  469.  
  470.   STk_add_new_primitive("when-socket-ready",   tc_subr_1_or_2, 
  471.             (STk_snow_is_running)? buggy_handler:  when_socket_ready);
  472.  
  473.   return UNDEFINED;
  474. }
  475.